perm filename TEST.SAI[CRE,BGB]1 blob
sn#036843 filedate 1973-04-25 generic text, type T, neo UTF8
00100 BEGIN "TEST COREL"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 α UPPER SEGMENT DEFINITIONS;
00400 DEFINE CALLI = "'047000000000";
00500 DEFINE CORE2 = "'400015";
00600 DEFINE ATTSEG = "'400016";
00700 DEFINE DETSEG = "'400017";
00800 DEFINE SEGSIZ = "'400022";
00900 DEFINE SETNM2 = "'400036";
01000 DEFINE NAMEIN = "'400043";
01100 DEFINE SAISEG = "'634151634722";
01200 DEFINE _PROBE = "'126062574245";
01300 DEFINE _TARGT = "'126441624764";
01400 DEFINE HALT = "JRST 4,";
01500 α BUFFERS;
01600 INTEGER ARRAY HEADER[0:9],TVBUF[1:10368];
01700 STRING PROBE,TARGT;
01800 INTEGER FLG;
01900 REAL THRESH,RMAX,MAXRAD,AVGRAD;
02000 INTEGER NCNT,II,JJ,TIME1,TIME2;
02100 INTEGER R1,R2,C1,C2,M1,M2,N1,N2;
02200 INTEGER FLG1,FLG2,FLG3;
02300 INTEGER CHR;
00100 INTEGER MYJOB#,SUBJOBNAME,LTRPTR;
00200 SAFE INTEGER ARRAY LETTER[0:31];
00300 DEFINE MAIL = "'710000000000";
00400
00500 PROCEDURE SUBRUN;
00600 BEGIN "SUBRUN"
00700 STRING STR; INTEGER LINE;
00800 START_CODE
00900 MOVE SUBJOBNAME;
01000 '047000400043;
01100 SKIPA;
01200 POPJ '17,;
01300 END;
01400 LINE ← PTYGET;
01500 PTOSTR(LINE,"L"&↓);
01600 STR←PTYSTR(LINE,"L");
01700 α OUTSTR(STR&"L");
01800 STR←PTYSTR(LINE,"#");
01900 α OUTSTR(STR&"#");
02000 PTOSTR(LINE,"COR/BGB"&↓);
02100 STR←PTYSTR(LINE,"B");
02200 α OUTSTR(STR&"B");
02300 STR←PTYSTR(LINE,"B");
02400 α OUTSTR(STR&"B");
02500 STR←PTYSTR(LINE,".");
02600 α OUTSTR(STR&".");
02700 PTOSTR(LINE,"RU COREL"&↓);
02800 CALL(2,"SLEEP");
02900 STR←PTYSTR(LINE,"*");
03000 α OUTSTR(STR&"*");
03100 END "SUBRUN";
00100 PROCEDURE SUBCALL;
00200 START_CODE "SUBCALL"
00300 LABEL L1,L2;
00400 SKIPE 1,MYJOB#;
00500 JRST L1;
00600 α INITIALIZATION;
00700 '047040000030;
00800 MOVEM 1,MYJOB#;
00900 MOVE SUBJOBNAME;
01000 '047000400043;
01100 PUSHJ '17,SUBRUN;
01200 MOVE LETTER;
01300 HRRZM LTRPTR;
01400 HRRM L2;
01500 MOVE 1,MYJOB#;
01600 α SEND A COMMAND AND ARGUMENTS LETTER;
01700 L1: MOVEM 1,@LTRPTR;
01800 MAIL SUBJOBNAME;
01900 JRST 4,;
02000 α WAIT FOR THE RESULTS LETTER;
02100 L2: MAIL 1,
02200 END "SUBCALL";
02300
00100 PROCEDURE INIT;
00200 BEGIN "INIT"
00300 SUBJOBNAME← '435762455400;
00400 R1←40;C1←224;M1←N1←6;
00500 R2←35;C2←220;M2←25;N2←30;
00600 END "INIT";
00100 PROCEDURE GETPROBE;
00200 BEGIN "GETPROBE"
00300 OPEN(1,"DSK",8,3,0,0,0,0);
00400 DO BEGIN
00500 OUTSTR(9&"PROBE = ");
00600 PROBE ← INCHWL;
00700 LOOKUP(1,PROBE&".TMP[DAT,BGB]",FLG);
00800 END UNTIL ¬FLG;
00900 ARRYIN(1,HEADER[0],10);
01000 ARRYIN(1,TVBUF[1],10368);
01100 START_CODE
01200 MOVE 1, [10400];
01300 CALLI DETSEG;
01400 MOVE [_PROBE];
01500 CALLI ATTSEG;
01600 SKIPA;SKIPA;;
01700 CALLI 1, CORE2;
01800 JFCL;
01900 HRLZ TVBUF;
02000 HRRI '400001;
02100 BLT '424201;
02200 MOVE [_PROBE];
02300 CALLI SETNM2;
02400 JFCL;
02500 CALLI 1, DETSEG;
02600 MOVE [SAISEG];
02700 CALLI ATTSEG;
02800 HALT;
02900 END;
03000 RELEASE(1);
03100 END "GETPROBE";
00100 PROCEDURE GETARGET;
00200 BEGIN "GETARGET"
00300 OPEN(1,"DSK",8,3,0,0,0,0);
00400 DO BEGIN
00500 OUTSTR(9&"TARGT = ");
00600 TARGT ← INCHWL;
00700 LOOKUP(1,TARGT&".TMP[DAT,BGB]",FLG);
00800 END UNTIL ¬FLG;
00900 ARRYIN(1,HEADER[0],10);
01000 ARRYIN(1,TVBUF[1],10368);
01100 START_CODE
01200 MOVE 1, [10400];
01300 CALLI DETSEG;
01400 MOVE [_TARGT];
01500 CALLI ATTSEG;
01600 SKIPA;SKIPA;;
01700 CALLI 1, CORE2;
01800 JFCL;
01900 HRLZ TVBUF;
02000 HRRI '400001;
02100 BLT '424201;
02200 MOVE [_TARGT];
02300 CALLI SETNM2;
02400 JFCL;
02500 CALLI 1, DETSEG;
02600 MOVE [SAISEG];
02700 CALLI ATTSEG;
02800 HALT;
02900 END;
03000 RELEASE(1);
03100 END "GETARGET";
00100 PROCEDURE CORELCALL;
00200 BEGIN "CORELCALL"
00300 α ARGUMENTS;
00400 LETTER[1] ← FLG1; α AUTO/CROSS ;
00500 LETTER[2] ← FLG2; α RESULT SEG ;
00600 LETTER[3] ← FLG3; α SNARF SEGMENTS;
00650 IF FLG3 THEN BEGIN SUBCALL;RETURN;END;
00700 α PROBE WINDOW;
00800 LETTER[4] ← R1;
00900 LETTER[5] ← C1;
01000 LETTER[6] ← M1;
01100 LETTER[7] ← N1;
01200 α TARGET WINDOW;
01300 LETTER[8] ← R2;
01400 LETTER[9] ← C2;
01500 LETTER[10] ← M2;
01600 LETTER[11] ← N2;
01700 α THRESHOLD;
01800 OPEN(2,"TTY",0,1,0,30,0,0);
01900 OUTSTR(9&"THRESHOLD = ");
02000 THRESH ← REALIN(2);
02100 RELEASE(2);
02200 QUICK_CODE
02300 MOVE 11,LETTER;
02400 MOVE 12,THRESH;
02500 MOVEM 12,12(11);
02600 END;
02700 SUBCALL;
02800 START_CODE
02900 MOVE 1,LETTER;
03000 MOVE 15(1); MOVEM RMAX;
03100 MOVE 16(1); MOVEM NCNT;
03200 MOVE 17(1); MOVEM MAXRAD;
03300 MOVE 18(1); MOVEM AVGRAD;
03400 MOVE 19(1); MOVEM TIME1;
03500 MOVE 20(1); MOVEM TIME2;
03600 END;
03700 OUTSTR(9&"RMAX ="&9&CVG(RMAX)&↓);
03800 OUTSTR(9&"NCNT ="&9&CVS(NCNT)&↓);
03900 OUTSTR(9&"MAXRAD ="&9&CVG(MAXRAD)&↓);
04000 OUTSTR(9&"AVGRAD ="&9&CVG(AVGRAD)&↓);
04100 OUTSTR(9&"II ="&9&CVS(LETTER[13])&9);
04200 OUTSTR("JJ ="&9&CVS(LETTER[14])&↓);
04300 SETFORMAT(0,3);
04400 OUTSTR(9&"RUN TIME "&CVS(TIME1%60000)&":"&CVF((TIME1 MOD 60000)/1000)&13&10);
04500 OUTSTR(9&"REAL TIME "&CVS(TIME2%60000)&":"&CVF((TIME2 MOD 60000)/1000)&13&10);
04600 OUTSTR(9&"TIME SHARE"&9&CVS(100*TIME1/TIME2)&" %"&13&10);
04700 SETFORMAT(0,7);
04900 END "CORELCALL";
00100 α TTY COMMAND LISTEN LOOP;
00200 INIT;
00300 OUTSTR("*");
00400 WHILE TRUE DO
00500 BEGIN "FOREVER"
00600 CHR ← INCHRW;
00700 IF CHR="A" THEN BEGIN FLG1←0;CORELCALL;END ELSE
00800 IF CHR="C" THEN BEGIN FLG1←-1;CORELCALL;END ELSE
00900 IF CHR="P" THEN GETPROBE ELSE
01000 IF CHR="T" THEN GETARGET ELSE
01100 IF CHR="R" THEN FLG2←-1 ELSE
01200 IF CHR="N" THEN FLG2← 0 ELSE
01300 IF CHR="S" THEN BEGIN FLG3←-1;CORELCALL;FLG3←0;END ELSE
01400 OUTSTR(9&"??????");
01500 OUTSTR(↓&"*");
01600 END "FOREVER";
01700 END "TEST COREL";